home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / SmallTalk / CObject.st < prev    next >
Text File  |  1995-08-25  |  8KB  |  512 lines
  1. "======================================================================
  2. |
  3. | Copyright (C) 1990, 1991, 1992 Free Software Foundation, Inc.
  4. | Written by Steve Byrne.
  5. |
  6. | This file is part of GNU Smalltalk.
  7. |
  8. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  9. | under the terms of the GNU General Public License as published by the Free
  10. | Software Foundation; either version 1, or (at your option) any later version.
  11. | 
  12. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  13. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  14. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  15. | details.
  16. | 
  17. | You should have received a copy of the GNU General Public License along with
  18. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  19. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  20. |
  21.  ======================================================================"
  22.  
  23. "
  24. |     Change Log
  25. | ============================================================================
  26. | Author       Date       Change 
  27. | sbb         16 Feb 92      created summer 90.
  28. |
  29. "
  30.  
  31. !CObject methodsFor: 'inspection'!
  32.  
  33. inspect
  34.     ^self value printNl
  35. !!
  36.  
  37.  
  38. " ### Should keep scalar types from doing at: -- rehack to be basicAt:
  39.  and remove at: from class CScalar"
  40.  
  41. CObject variableWordSubclass: #CLong
  42.     instanceVariableNames: ''
  43.     classVariableNames: ''
  44.     poolDictionaries: ''
  45.     category: 'C variable access'!
  46.  
  47. !CLong class methodsFor: 'accessing'!
  48.  
  49. sizeof
  50.     ^4
  51. !
  52.  
  53. alignof
  54.     ^4
  55. !!
  56.     
  57. !CLong methodsFor: 'accessing'!
  58.  
  59. value
  60.     ^super at: 0 type: 4        "should be symbolic, but I want SPEED!"
  61. !
  62.  
  63. value: aValue
  64.     super at: 0 put: aValue type: 4
  65. !
  66.  
  67. sizeof
  68.     ^4
  69. !
  70.  
  71. alignof
  72.     ^4
  73. !!
  74.  
  75.  
  76. CObject variableWordSubclass: #CULong
  77.     instanceVariableNames: ''
  78.     classVariableNames: ''
  79.     poolDictionaries: ''
  80.     category: 'C variable access'!
  81.  
  82. !CULong class methodsFor: 'accessing'!
  83.  
  84. sizeof
  85.     ^4
  86. !
  87.  
  88. alignof
  89.     ^4
  90. !!
  91.     
  92.  
  93.  
  94. !CULong methodsFor: 'accessing'!
  95.  
  96. value
  97.     ^self at: 0 type: 5        "should be symbolic, but I want SPEED!"
  98. !
  99.  
  100. value: aValue
  101.     self at: 0 put: aValue type: 5
  102. !
  103.  
  104. sizeof
  105.     ^4
  106. !
  107.  
  108. alignof
  109.     ^4
  110. !!
  111.  
  112.  
  113. CObject variableWordSubclass: #CShort
  114.     instanceVariableNames: ''
  115.     classVariableNames: ''
  116.     poolDictionaries: ''
  117.     category: 'C variable access'!
  118.  
  119. !CShort class methodsFor: 'accessing'!
  120.  
  121. sizeof
  122.     ^2
  123. !
  124.  
  125. alignof
  126.     ^2
  127. !!
  128.     
  129.  
  130.  
  131. !CShort methodsFor: 'accessing'!
  132.  
  133. value
  134.     ^self at: 0 type: 2        "should be symbolic, but I want SPEED!"
  135. !
  136.  
  137. value: aValue
  138.     self at: 0 put: aValue type: 2
  139. !
  140.  
  141. sizeof
  142.     ^2
  143. !
  144.  
  145. alignof
  146.     ^2
  147. !!
  148.  
  149.  
  150. CObject variableWordSubclass: #CUShort
  151.     instanceVariableNames: ''
  152.     classVariableNames: ''
  153.     poolDictionaries: ''
  154.     category: 'C variable access'!
  155.  
  156. !CUShort class methodsFor: 'accessing'!
  157.  
  158. sizeof
  159.     ^2
  160. !
  161.  
  162. alignof
  163.     ^2
  164. !!
  165.     
  166. !CUShort methodsFor: 'accessing'!
  167.  
  168. value
  169.     ^self at: 0 type: 3        "should be symbolic, but I want SPEED!"
  170. !
  171.  
  172. value: aValue
  173.     self at: 0 put: aValue type: 3
  174. !
  175.  
  176. sizeof
  177.     ^2
  178. !
  179.  
  180. alignof
  181.     ^2
  182. !!
  183.  
  184.  
  185.  
  186. CObject variableWordSubclass: #CChar
  187.     instanceVariableNames: ''
  188.     classVariableNames: ''
  189.     poolDictionaries: ''
  190.     category: 'C variable access'!
  191.  
  192. !CChar class methodsFor: 'accessing'!
  193.  
  194. sizeof
  195.     ^1
  196. !
  197.  
  198. alignof
  199.     ^1
  200. !!
  201.     
  202. !CChar methodsFor: 'accessing'!
  203.  
  204. value
  205.     ^self at: 0 type: 0        "should be symbolic, but I want SPEED!"
  206. !
  207.  
  208. value: aValue
  209.     self at: 0 put: aValue type: 0
  210. !
  211.  
  212. sizeof
  213.     ^1
  214. !
  215.  
  216. alignof
  217.     ^1
  218. !!
  219.  
  220.  
  221.  
  222.  
  223. CObject variableWordSubclass: #CUChar
  224.     instanceVariableNames: ''
  225.     classVariableNames: ''
  226.     poolDictionaries: ''
  227.     category: 'C variable access'!
  228.  
  229. !CUChar class methodsFor: 'getting info'!
  230.  
  231. sizeof
  232.     ^1
  233. !
  234.  
  235. alignof
  236.     ^1
  237. !!
  238.  
  239. !CUChar methodsFor: 'accessing'!
  240.  
  241. value
  242.     ^self at: 0 type: 1        "should be symbolic, but I want SPEED!"
  243. !
  244.  
  245. value: aValue
  246.     self at: 0 put: aValue type: 1
  247. !
  248.  
  249. sizeof
  250.     ^1
  251. !
  252.  
  253. alignof
  254.     ^1
  255. !!
  256.  
  257.  
  258.  
  259. CObject variableWordSubclass: #CFloat
  260.     instanceVariableNames: ''
  261.     classVariableNames: ''
  262.     poolDictionaries: ''
  263.     category: 'C variable access'!
  264.  
  265. !CFloat class methodsFor: 'accessing'!
  266.  
  267. sizeof
  268.     ^4
  269. !
  270.  
  271. alignof
  272.     ^4
  273. !!
  274.     
  275. !CFloat methodsFor: 'accessing'!
  276.  
  277. value
  278.     ^self at: 0 type: 6        "should be symbolic, but I want SPEED!"
  279. !
  280.  
  281. value: aValue
  282.     self at: 0 put: aValue type: 6
  283. !
  284.  
  285. sizeof
  286.     ^4
  287. !
  288.  
  289. alignof
  290.     ^4
  291. !!
  292.  
  293.  
  294.  
  295. CObject variableWordSubclass: #CDouble
  296.     instanceVariableNames: ''
  297.     classVariableNames: ''
  298.     poolDictionaries: ''
  299.     category: 'C variable access'!
  300.  
  301. !CDouble class methodsFor: 'accessing'!
  302.  
  303. sizeof
  304.     ^8
  305. !
  306.  
  307. alignof
  308.     ^8                "### should ask system"
  309. !!
  310.     
  311. !CDouble methodsFor: 'accessing'!
  312.  
  313. value
  314.     ^self at: 0 type: 7        "should be symbolic, but I want SPEED!"
  315. !
  316.  
  317. value: aValue
  318.     self at: 0 put: aValue type: 7
  319. !
  320.  
  321. sizeof
  322.     ^8
  323. !
  324.  
  325. alignof
  326.     ^8
  327. !!
  328.  
  329.  
  330. CObject variableWordSubclass: #CString
  331.     instanceVariableNames: ''
  332.     classVariableNames: ''
  333.     poolDictionaries: ''
  334.     category: 'C variable access'!
  335.  
  336. !CString class methodsFor: 'getting info'!
  337.  
  338. sizeof
  339.     ^4
  340. !
  341.  
  342. alignof
  343.     ^4
  344. !!
  345.  
  346. !CString methodsFor: 'accessing'!
  347.  
  348. value
  349.     ^self at: 0 type: 8        "should be symbolic, but I want SPEED!"
  350. !
  351.  
  352. value: aValue
  353.     self at: 0 put: aValue type: 8
  354. !
  355.  
  356. sizeof
  357.     ^4
  358. !
  359.  
  360. alignof
  361.     ^4
  362. !!
  363.  
  364.  
  365.  
  366.  
  367. CObject variableWordSubclass: #CArray
  368.     instanceVariableNames: ''
  369.     classVariableNames: ''
  370.     poolDictionaries: ''
  371.     category: 'C variable access'!
  372.  
  373. !CArray methodsFor: 'accessing'!
  374.  
  375. at: anIndex
  376.     | type |
  377. "'in carray' printNl."
  378.     type _ self type.
  379. "'type is ' print. type inspect.
  380. 'index is ' print. anIndex printNl.
  381. 'subtype is ' print. type subType printNl.
  382. 'sizeof says ' print. type subType sizeof printNl."
  383.     ^self at: (anIndex * type subType sizeof) type: type subType
  384. "??? use baseType to hold component type info?"
  385. !
  386.  
  387. at: anIndex put: aValue
  388.     " ### Is this the right implementation?"
  389.     ^self at: 0 type: self type subType
  390. !
  391.  
  392. sizeof
  393.     | type |
  394.     type _ self type.
  395.     ^type numElements * type subType sizeof
  396. !
  397.  
  398. alignof
  399.     ^self type subType alignof
  400. !
  401.  
  402. inspect
  403.     | type |
  404.     type _ self type.
  405.     stdout nextPutAll: '['; nl.
  406.     1 to: type numElements do: 
  407.     [ :i | stdout nextPutAll: '    '.
  408.            self at: i inspect ].
  409.     stdout nextPutAll: ']'; nl
  410. !!
  411.  
  412. CObject variableWordSubclass: #CPtr
  413.     instanceVariableNames: ''
  414.     classVariableNames: ''
  415.     poolDictionaries: ''
  416.     category: 'C variable access'!
  417.  
  418.  
  419. !CPtr class methodsFor: 'accessing'!
  420.  
  421. sizeof
  422.     ^4
  423. !
  424.  
  425. alignof
  426.     ^4
  427. ! !
  428.  
  429.  
  430.  
  431. !CPtr methodsFor: 'accessing'!
  432.  
  433. deref
  434.     ^self value
  435. !
  436.  
  437. at: anIndex
  438.     | type |
  439.     type _ self type.
  440.     ^self at: (anIndex * type subType sizeof) type: 9
  441. !
  442.  
  443. value
  444.     ^self at: 0
  445. !
  446.  
  447. value: aValue
  448.     ^self at: 0 put: aValue type: nil
  449.     "Type doesn't matter"
  450. !
  451.  
  452. sizeof
  453.     ^4
  454. !
  455.  
  456. alignof
  457.     ^4
  458. !
  459.  
  460. inspect
  461.     stdout nextPutAll: '--> '.
  462.     self value inspect
  463. !!
  464.  
  465.  
  466.  
  467. CUChar variableWordSubclass: #CByte
  468.        instanceVariableNames: ''
  469.        classVariableNames: ''
  470.        poolDictionaries: ''
  471.        category: 'C variable access'
  472. !
  473.  
  474. CByte comment: 'You''re a marine.
  475. You adapt -- you improvise -- you overcome
  476.  
  477.                         - Gunnery Sgt. Thomas Highway
  478.                           Heartbreak Ridge'!
  479.  
  480. !CByte methodsFor: 'accessing'!
  481.  
  482. value
  483.     ^super value asciiValue
  484. !
  485.  
  486. value: anInteger
  487.     ^super value: (Character value: anInteger)
  488. !!
  489.  
  490. Smalltalk at: #CCharType
  491.       put: (CType baseType: CChar subType: CChar "0").
  492. Smalltalk at: #CUCharType
  493.       put: (CType baseType: CUChar subType: CUChar "1").
  494. Smalltalk at: #CShortType
  495.       put: (CType baseType: CShort subType: CShort "2").
  496. Smalltalk at: #CUShortType
  497.       put: (CType baseType: CUShort subType: CUShort "3").
  498. Smalltalk at: #CLongType
  499.       put: (CType baseType: CLong subType: CLong "4").
  500. Smalltalk at: #CULongType
  501.       put: (CType baseType: CULong subType: CULong "5").
  502. Smalltalk at: #CFloatType
  503.       put: (CType baseType: CFloat subType: CFloat "6").
  504. Smalltalk at: #CDoubleType
  505.       put: (CType baseType: CDouble subType: CDouble "7").
  506. Smalltalk at: #CStringType
  507.       put: (CType baseType: CString subType: CString).
  508. Smalltalk at: #CByteType
  509.       put: (CType baseType: CByte subType: CByte "0")
  510. !
  511.  
  512.